home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / files.swg / 0072_Data Input-Output Routines.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-26  |  55.3 KB  |  1,535 lines
  1. {
  2. I am posting these because I feel they have been "optimized' beyond my
  3. abilities.  If you find a way to further optimize it, by speed, memory
  4. requirements, and other things, please SEND ME THE VERSION!
  5.  
  6. I have a favour to ask all pascalians.  These routines seem to lock up
  7. sometimes during the Retrieve_Function when I'm in a tight memory situation.
  8. I say tight as I have less then 500k free in one of my programs.  If
  9. someone could rewrite the part which copies (ie. BufSize parts), I would
  10. gladly appreciate it.  Thanks!
  11. }
  12.  
  13. UNIT DATAIO;
  14. {                        DATA Input/Output Routines
  15.  
  16.                       Given to the People as FreeWare
  17.                           Includable into SWAG and
  18.                          made expecialy for SWAG :)
  19.                            AUTHOR: BOJAN LANDEKIC
  20.                            SUBJECT: FILE DATA STORAGE (DATAIO)
  21.  
  22.  These routines allow you to take any number of files (max 255 as I used BYTE
  23.  but you can change the limit to 65535 by using WORD instead).  As I said, it
  24.  allows you to take that many files (or less) and include them into a single
  25.  file (ie. ALLFILES.DAT).  Then you can retrieve/add/delete/view this file.
  26.  I am testing out DATAIO v2.0 with encryption and compression routines, and
  27.  that will be released into the Freeware as well.
  28.  
  29.  The three sub-units I use are STRIO (string handlers), FILEIO (file in/out
  30.  routines) and VARS (a global declaration unit that is included everywhere).
  31.  
  32.  Each routine is a FUNCTION and returns an error code (0 if okay).  The
  33.  error codes are examplained under the name of each of the functions.
  34.  
  35.  Even though this is made freeware I BEG everybody not to make changes and
  36.  distribute them as their own work <grin>.  If you make changes, LET ME KNOW
  37.  as I plan to make a compression program competitive to ZIP/ARJ and others.
  38.  
  39.  The routines which use the constant BufSize are taken from either FILES.SWG,
  40.  COPYMOVE.SWG, or DOS.SWG from SWAG archives.  I cannot remember who the
  41.  original author is, but I will check and when I find out, you will be
  42.  credited.
  43.  
  44. }
  45.  
  46. INTERFACE
  47.  
  48. Uses Vars,
  49.      StrIo,
  50.      FileIO,
  51.      Crt,
  52.      Dos;
  53.  
  54.      FUNCTION Retrieve_File(DataFilename, Filename: String; Display: Boolean): Byte;
  55.      FUNCTION Add_File(DataFilename, Filename: String; Display: Boolean): Byte;
  56.      FUNCTION Remove_File(DataFilename, Filename: String; Display: Boolean): Byte;
  57.      FUNCTION Show_File(DataFilename, Filename: String): Byte;
  58.  
  59. IMPLEMENTATION
  60.  
  61. FUNCTION Retrieve_File(DataFilename, Filename: String; Display: Boolean): Byte;
  62. {
  63.      This function returns the following:
  64.  
  65.      0 - [filename] has been retrieved successfully from [DataFilename]
  66.      1 - [DataFilename] was not found/does not exist/was not specified
  67.      2 - Header is incorrect (wrong file maybe?)
  68.      3 - [Filename] was not found in [datafilename]
  69.      4 - Not enough memory for FileBuf (decrese FileBuf)
  70.      5 - Not enough disk space for the to-be-extracted file
  71.  
  72.      Datafile is formed like this
  73.  
  74.      XXXXXXXXXX   - The header
  75.      ----------   - Individual file header #1  (information)
  76.      CCCCCCCCCC   - File #1 itself (data/code segment)
  77.      CCCCCCCCCC
  78.      CCCCCCCCCC
  79.      ----------   - Individual file header #2  (information)
  80.      CCCCCCCCCC   - file #2 itself (data/code segment)
  81.      CCCCCCCCCC
  82.      CCCCCCCCCC
  83.      CCCCCCCCCC
  84.      CCCCCCCCCC
  85.      ...          - ... you get the general idea
  86. }
  87.          Const
  88.               BufSize = 16384;
  89.  
  90.          {for the copy part}
  91.          Type
  92.              FBuf = array[1..BufSize] Of Char;
  93.              Fbf  = ^FBuf;
  94.  
  95.           Var
  96.              y,                         {date function}
  97.              m,
  98.              d,
  99.              dow,
  100.              h,                         {time function}
  101.              min,
  102.              s,
  103.              hund        : Word;
  104.              CurrentFile : Byte;        {for searching through files}
  105.              DataFile,
  106.              ExtractFile : File;        {file that's to be extracted}
  107.              Difference  : Longint;     {could be a WORD: diff betwen now-real}
  108.              OldPos,                    {used for updating the ORIGINAL header}
  109.              ExtractPos  : LongInt;     {current size of extractfile}
  110.  
  111.              Bread,                      {for fast/error-free copying}
  112.              Bwrite   :    word;
  113.              FileBuf  :    ^fbf;
  114.  
  115.              OldX,
  116.              OldY        : Byte;        {for display purposes only}
  117.  
  118.           Begin
  119.                {Check for enough available memory}
  120.                If (MemAvail > BufSize) then
  121.                   New(FileBuf)
  122.                Else
  123.                    begin
  124.                         Retrieve_File := 4;
  125.                         Exit;
  126.                    End;
  127.  
  128.                {check if file exists, or if a filename has been specified}
  129.                If (DataFilename = '') OR
  130.                   (Filename = '') OR
  131.                   NOT FileExists(DataFilename) Then
  132.                       Begin
  133.                            Retrieve_File := 1;
  134.                            Dispose(FileBuf);
  135.                            Exit;
  136.                       End;
  137.  
  138.                {open the file}
  139.                Assign(DataFile, DataFilename);
  140.                Filemode := 2;
  141.                Reset(DataFile, 1);
  142.  
  143.                {open the file to be extracted/made}
  144.                Assign(ExtractFile, Filename);
  145.                Filemode := 2;
  146.                Rewrite(ExtractFile, 1);
  147.  
  148.                {check for the header id}
  149.                BlockRead(DataFile, Header, SizeOf(Header));
  150.                If NOT (Header.Identification = Id_Check) Then
  151.                   Begin
  152.                        {if the header not the same then it's not one of ours}
  153.                        Retrieve_File := 2;
  154.                        Dispose(FileBuf);
  155.                        Exit;
  156.                   End;
  157.  
  158.                {Go to the beginning of the first individual file header}
  159.                Seek(DataFile, SizeOf(Header));
  160.  
  161.                If Display Then
  162.                   Begin
  163.                        Write('Searching...');
  164.                   End;
  165.                {loop through all the entries until [filename] is found}
  166.                For CurrentFile := 1 To Header.NumberOfFiles Do
  167.                    Begin
  168.                         {read the header}
  169.                         FillChar(FileHeader, SizeOf(FileHeader), #0);
  170.                         BlockRead(DataFile, FileHeader, SizeOf(FileHeader));
  171.  
  172.                         {so the user doesn't think we're lazy :)}
  173.                         {Writeln('Processing...');
  174.                         Writeln('Filename : ', FileHeader.Filename);
  175.                         Writeln('Size     : ', FileHeader.RealSize);}
  176.  
  177.                         {compare this file to the one the user wants}
  178.                         If (FileHeader.Filename = Filename) Then
  179.                            Begin
  180.                                 {A-Ha, it is the file, extract it!}
  181.                                 {check for disk space}
  182.                                 If (DiskFree(0) < FileHeader.RealSize) Then
  183.                                    Begin
  184.                                         Retrieve_File := 5;
  185.                                         Dispose(FileBuf);
  186.                                         Close(DataFile);
  187.                                         Close(ExtractFile);
  188.                                         Exit;
  189.                                    End;
  190.                                 ExtractPos := 0;
  191.                                 If Display Then
  192.                                    Begin
  193.                                         TextBackground(0);
  194.                                         TextColor(7);
  195.                                         GotoXY(1, WhereY);
  196.                                         ClrEol;
  197.                                         Write('Extracting ' + Filename + ': ');
  198.                                         OldX := WhereY;
  199.                                         OldY := WhereY;
  200.                                    End;
  201.                                 {make sure we update the header, since the
  202.                                  file is being "updated" as you might see}
  203.                                 OldPos := FilePos(DataFile);
  204.                                 GetDate(y, m, d, dow);
  205.                                 GetTime(h, min, s, hund);
  206.                                 Header.UpdatedOn := Leading_Zero(ITOA(m), 2) + '-' +
  207.                                                     Leading_Zero(ITOA(d), 2) + '-' +
  208.                                                     Leading_Zero(ITOA(y), 4) +
  209.                                                     Leading_Zero(ITOA(h), 2) + ':' +
  210.                                                     Leading_Zero(ITOA(min), 2);
  211.                                 Seek(DataFile, 0);
  212.                                 BlockWrite(DataFile, Header, SizeOf(Header));
  213.                                 Seek(DataFile, OldPos);
  214.                                 Repeat
  215.                                       BlockRead(DataFile, FileBuf^, BufSize, Bread);
  216.                                       BlockWrite(ExtractFile, FileBuf^, Bread, Bwrite);
  217.                                       Inc(ExtractPos, Bread);
  218.                                       If Display Then
  219.                                          Begin
  220.                                               GotoXY(OldX, OldY);
  221.                                               If (ExtractPos <= FileHeader.RealSize) Then
  222.                                                  Write(StatusBar(FileHeader.RealSize, ExtractPos, 42))
  223.                                               Else
  224.                                                   Write(StatusBar(1, 1, 42)); {100% effect :)}
  225.                                          End;
  226.                                 Until (Bread = 0) OR (Bread <> Bwrite) OR
  227.                                       (ExtractPos > FileHeader.RealSize);
  228.  
  229.                                 {To compensate for the over-write}
  230.                                 If (ExtractPos > FileHeader.RealSize) Then
  231.                                    Begin
  232.                                         Difference := (ExtractPos - FileHeader.RealSize);
  233.                                         {Seek to the part where THIS file is supposed to end}
  234.                                         Seek(ExtractFile, FilePos(ExtractFile) - Difference);
  235.                                         {Erase the extra garbage}
  236.                                         Truncate(Extractfile);
  237.                                         {Unneccesery, but just to be sure for multiple extractions}
  238.                                         Seek(DataFile, FilePos(DataFile) - Difference);
  239.                                    End;
  240.                                 {extracted, now we quit}
  241.                                 Retrieve_File := 0;
  242.                                 Dispose(FileBuf);
  243.                                 Close(DataFile);
  244.                                 Close(ExtractFile);
  245.                                 If Display Then
  246.                                    Begin
  247.                                         GotoXY(OldX, OldY);
  248.                                         ClrEol;
  249.                                         Writeln('Done!');
  250.                                    End;
  251.                                 Exit;
  252.                            End
  253.                         Else
  254.                             Begin
  255.                                  {Go to next record, right}
  256.                                  Seek(DataFile, FilePos(DataFile) + FileHeader.RealSize);
  257.                             End;
  258.  
  259.                    End;
  260.  
  261.                {If we get to here, means the file was not in the datafile}
  262.                Retrieve_File := 3;
  263.                Dispose(FileBuf);
  264.                Close(DataFile);
  265.                Close(ExtractFile);
  266.           End;
  267.  
  268.  
  269. FUNCTION Add_File(DataFilename, Filename: String; Display: Boolean): Byte;
  270. { - The part that "copyies" the file was gotten from SWAG, the original
  271.     author of the "copying" part was Floor A.C. Naaijkens
  272. }
  273.  
  274. {
  275.      This function can possibly return the following values:
  276.  
  277.      0 - [filename] has been successfully added to [datafilename]
  278.      1 - [datafilename] and/or [filename] have not be specified/don't exist
  279.      2 - Could not create/open [datafilename]
  280.      3 - [datafilename] is not one of our files, wrong file type maybe??
  281.      4 - [filename] opening error
  282.      5 - Not enough memory (on the stack, 16386 needed)..  Decrease BufSize
  283.      6 - Error during copy
  284.      7 - No more files allowed (254 file limit reached
  285. }
  286.  
  287.          {for the copy part}
  288.          Const
  289.               BufSize = 16384;
  290.  
  291.          {for the copy part}
  292.          Type
  293.              FBuf = array[1..BufSize] Of Char;
  294.              Fbf  = ^FBuf;
  295.  
  296.          Var
  297.             y,
  298.             m,
  299.             d,
  300.             dow,                        {for the date}
  301.             h,
  302.             min,
  303.             s,
  304.             hund    : Word;             {for the time}
  305.  
  306.             DataFile,
  307.             AddFile : File;             {file to be added}
  308.             NewFile : Boolean;          {specifies wheter [datafile] is new}
  309.  
  310.             Bread,                      {for fast/error-free copying}
  311.             Bwrite   :    word;
  312.             FileBuf  :    ^fbf;
  313.  
  314.             OldX,
  315.             OldY     : Byte;
  316.             StartAt  : LongInt;         {for display purposes only}
  317.  
  318.             DirInfo     : SearchRec;
  319.  
  320.          Begin
  321.               {Check for enough available memory}
  322.               If (MemAvail > BufSize) then
  323.                  New(FileBuf)
  324.               else
  325.                   begin
  326.                        Add_File := 5;
  327.                        Exit
  328.                   End;
  329.  
  330.                {check if file exists, or if a filename has been specified}
  331.                If (DataFilename = '') OR (Filename = '') Then
  332.                   Begin
  333.                        Add_File := 1;
  334.                        Exit;
  335.                   End;
  336.  
  337.                {check if the datafile exists}
  338.                Assign(DataFile, DataFilename);
  339.                IF NOT FileExists(Datafilename) Then
  340.                   Begin
  341.                        {$I-}
  342.                        FileMode := 2;
  343.                        Rewrite(DataFile, 1);
  344.                        IF (IOResult <> 0) Then
  345.                           Begin
  346.                                Add_File := 2;
  347.                                Dispose(FileBuf);
  348.                                Exit;
  349.                           End;
  350.                        {$I+}
  351.                        NewFile := True;
  352.                   End
  353.                Else
  354.                    Begin
  355.                         FileMode := 2;
  356.                         {$I-}
  357.                         Reset(DataFile, 1);
  358.                         {$I+}
  359.                         IF (IOResult <> 0) Then
  360.                            Begin
  361.                                 Add_File := 2;
  362.                                 Dispose(FileBuf);
  363.                                 Exit;
  364.                            End;
  365.                         NewFile := False;
  366.                    End;
  367.  
  368.                If NewFile Then
  369.                   {New file initialization}
  370.                   Begin
  371.                        Getdate(y, m, d, dow);
  372.                        GetTime(h, min, s, hund);
  373.                        FillChar(Header, SizeOf(Header), #0);
  374.                        Header.Identification := Id_Check;
  375.                        Header.CreatedOn := Leading_Zero(ITOA(m), 2) + '-' +
  376.                                            Leading_Zero(ITOA(d), 2) + '-' +
  377.                                            Leading_Zero(ITOA(y), 4) +
  378.                                            Leading_Zero(ITOA(h), 2) + ':' +
  379.                                            Leading_Zero(ITOA(min), 2);
  380.                        Header.UpdatedOn := Header.CreatedOn;
  381.                        Header.NumberOfFiles := 0;
  382.                        BlockWrite(DataFile, Header, SizeOf(Header));
  383.                        Seek(DataFile, 0);
  384.                   End;
  385.  
  386.                {Already existing file initialization}
  387.                BlockRead(Datafile, Header, SizeOf(Header));
  388.  
  389.                     {check for the ID string}
  390.                If NOT (Header.Identification = Id_Check) Then
  391.                   Begin
  392.                        Add_File := 3;
  393.                        Dispose(FileBuf);
  394.                        Close(DataFile);
  395.                        Exit;
  396.                   End;
  397.  
  398.                {Go to the appropriate place in the datafile where
  399.                 the writing will start}
  400.                Filename := Strip_Path(UCase(Filename));
  401.                FindFirst(Filename, Archive, DirInfo);
  402.                While (DosError = 0) Do
  403.                      Begin
  404.                           Assign(AddFile, DirInfo.Name);
  405.                           Filemode := 2;
  406.                           {$I-}
  407.                           Reset(AddFile, 1);
  408.                           {$I+}
  409.                           IF (IOResult <> 0) Then
  410.                              Begin
  411.                                   Add_File := 4;
  412.                                   Close(DataFile);
  413.                                   Dispose(FileBuf);
  414.                                   Exit;
  415.                              End;
  416.  
  417.                           If (Header.NumberOffiles > 254) Then
  418.                              Begin
  419.                                   Add_File := 8;
  420.                                   Dispose(FileBuf);
  421.                                   Close(DataFile);
  422.                                   Exit;
  423.                              End
  424.                           Else
  425.                               Inc(Header.NumberOfFiles);
  426.  
  427.                           Header.UpdatedOn := Leading_Zero(ITOA(m), 2) + '-' +
  428.                                               Leading_Zero(ITOA(d), 2) + '-' +
  429.                                               Leading_Zero(ITOA(y), 4) +
  430.                                               Leading_Zero(ITOA(h), 2) + ':' +
  431.                                               Leading_Zero(ITOA(min), 2);
  432.                           Seek(DataFile, 0);
  433.                           BlockWrite(DataFile, Header, SizeOf(Header));
  434.                           Seek(DataFile, FileSize(DataFile));
  435.  
  436.                           {Here we set the individual file header to the appropriate
  437.                           information}
  438.                           FillChar(FileHeader, SizeOf(FileHeader), #0);
  439.  
  440.                           FileHeader.Attribute := 0;
  441.                           FileHeader.Filename := Dirinfo.Name;
  442.                           FileHeader.CompType := 0;
  443.                           FileHeader.RealSize := FileSize(AddFile);
  444.                           FileHeader.CompSize := FileHeader.RealSize;
  445.                           FileHeader.Crc := 0;
  446.  
  447.                           {check for disk space}
  448.                           If (DiskFree(0) < FileHeader.RealSize) Then
  449.                              Begin
  450.                                   Add_File := 5;
  451.                                   Dispose(FileBuf);
  452.                                   Close(DataFile);
  453.                                   Exit;
  454.                              End;
  455.                           BlockWrite(DataFile, FileHeader, SizeOf(FileHeader));
  456.  
  457.                           {copy the file}
  458.                           If Display Then
  459.                              Begin
  460.                                   TextBackground(0);
  461.                                   TextColor(7);
  462.                                   Write('Adding ' + Dirinfo.Name + ': ');
  463.                                   OldX := WhereX;
  464.                                   OldY := WhereY;
  465.                              End;
  466.  
  467.                           StartAt := FilePos(DataFile);
  468.                           Repeat
  469.                                 BlockRead(AddFile, FileBuf^, BufSize, Bread);
  470.                                 BlockWrite(DataFile, FileBuf^, Bread, Bwrite);
  471.                                 If Display Then
  472.                                    Begin
  473.                                         GotoXY(OldX, OldY);
  474.                                         Write(StatusBar(FileHeader.RealSize, (FilePos(DataFile) - StartAt), 50));
  475.                                    End;
  476.                           Until (Bread = 0) OR (Bread <> Bwrite);
  477.  
  478.                           Close(AddFile);
  479.                           If Display Then
  480.                              Begin
  481.                                   GotoXY(OldX, Oldy);
  482.                                   ClrEol;
  483.                              End;
  484.                           If (Bread <> Bwrite) then
  485.                              Begin
  486.                                   If Display Then
  487.                                      Writeln('Error occured while adding!');
  488.                                   Add_File := 6
  489.                              End
  490.                           Else
  491.                               Begin
  492.                                    If Display Then
  493.                                       Writeln('Done!');
  494.                                    Add_File := 0;
  495.                               End;
  496.                           FindNext(DirInfo);
  497.                      End; {while loop}
  498.                Dispose(FileBuf);
  499.                Close(DataFile);
  500.          End;
  501.  
  502.  
  503. FUNCTION Remove_File(DataFilename, Filename: String; Display: Boolean): Byte;
  504. {  This function returns the following:
  505.  
  506.    0 - [filename] has been succcessfully deleted from Datafilename
  507.    1 - [filename] or [datafilename] are empty or [datafilename] does not exist
  508.    2 - Not enough disk space (minimum = file size of [datafilename])
  509.    3 - [datafilename] is not of our type.  Maybe not the right format? Hmm..:)
  510. }
  511.          Const
  512.               tFilename    :    String[12] = 'DATA.!!!'; {temporary file}
  513.  
  514.          Var
  515.             OldX,
  516.             OldY,                          {for display}
  517.             TotalFiles,                    {just for the heck of it}
  518.             CurrentFile    : Byte;         {the for-end loop}
  519.             eFileHeader    : tFileHeader;  {Empty file header}
  520.             tDataFile,                     {only used by the Rename function}
  521.             DataFile       : File;         {file being worked on}
  522.             OldPos         : Longint;      {to be sure pointer is always there}
  523.  
  524.             Cur_File,                   {for multiple file additions}
  525.             Search_File : String[8];
  526.             Cur_Ext,
  527.             Search_Ext  : String[3];
  528.  
  529.          Begin
  530.               Assign(DataFile, DataFilename);
  531.               Assign(tDataFile, tFilename);
  532.  
  533.               {check if file exists, or if a filename has been specified}
  534.               If (DataFilename = '') OR
  535.                   (Filename = '') OR
  536.                   (NOT FileExists(DataFilename)) Then
  537.                        Begin
  538.                             Remove_File := 1;
  539.                             Exit;
  540.                        End
  541.                   Else
  542.                       Reset(DataFile, 1);
  543.  
  544.               {check for disk space}
  545.               If (DiskFree(0) < FileSize(DataFile)) Then
  546.                  Begin
  547.                       Remove_File := 2;
  548.                       Close(DataFile);
  549.                       Exit;
  550.                  End;
  551.  
  552.               {check for the header id}
  553.               BlockRead(DataFile, Header, SizeOf(Header));
  554.               If NOT (Header.Identification = Id_Check) Then
  555.                  Begin
  556.                       {if the header is not the same then it's not one of ours}
  557.                       Remove_File := 3;
  558.                       Exit;
  559.                  End;
  560.  
  561.                {Go to the beginning of the first individual file header}
  562.                Seek(DataFile, SizeOf(Header));
  563.  
  564.                Filename := UCase(Filename);
  565.                TotalFiles := Header.NumberOfFiles;
  566.                If Display Then
  567.                   Begin
  568.                        Writeln;
  569.                        Write('Removing: ' + Filename);
  570.                        OldX := WhereX + 1;
  571.                        OldY := WhereY;
  572.                   End;
  573.                {loop through all the entries until [filename] is found}
  574. {BUG!          Header.NumberOfFiles seems to change for some reason here!!}
  575.                Search_File := Copy(Filename, 1, Pos('.', Filename) - 1);
  576.                Search_Ext := Copy(Filename, Pos('.', Filename) + 1, Length(Filename));
  577.                For CurrentFile := 1 To TotalFiles Do
  578.                    Begin
  579.                         {read the header}
  580.                         FillChar(eFileHeader, SizeOf(eFileHeader), #0);
  581.                         BlockRead(DataFile, eFileHeader, SizeOf(eFileHeader));
  582.                         OldPos := FilePos(DataFile);
  583.  
  584.                         If Display Then
  585.                            Begin
  586.                                 GotoXy(OldX, OldY);
  587.                                 Write(StatusBar(TotalFiles, CurrentFile, 48));
  588.                            End;
  589.  
  590.                         {compare this file to the one the user wants}
  591.                         Cur_File := Copy(eFileHeader.Filename, 1, Pos('.', eFileHeader.Filename) - 1);
  592.                         Cur_Ext:=Copy(eFileHeader.Filename, Pos('.', eFileHeader.Filename) + 1, Length(eFileHeader.Filename));
  593.                         If (NOT Compare_Filenames(Search_File, Cur_File)) OR
  594.                            (NOT Compare_Filenames(Search_Ext, Cur_Ext)) Then
  595.                                 Begin
  596.                                      {remove it from the original archive}
  597.                                      Retrieve_File(DataFilename, eFileHeader.Filename, False);
  598.                                      {add it to the temporary archive}
  599.                                      Add_File(tFilename, eFileHeader.Filename, False);
  600.                                      {go to the next file}
  601.                                 End;
  602.                         Seek(DataFile, OldPos + eFileHeader.RealSize);
  603.                    End;
  604.                Close(DataFile);
  605.                Erase(DataFile);
  606.                Rename(tDataFile, DataFilename);
  607.          End;
  608.  
  609.  
  610. FUNCTION Show_File(DataFilename, Filename: String): Byte;
  611. { This functions returns the following:
  612.  
  613.    0 - Displayed
  614.    1 - [datafilename] is blank or does not exist!
  615.    2 - File is of wrong type, meaning it's not one made by this program.
  616. }
  617.  
  618.          Var
  619.             OldY           : Byte;
  620.             DataFile       : File;
  621.             CurrentFile    : Byte;
  622.  
  623.             Cur_File,                        {current file name without extension}
  624.             Search_File    : String[8];      {file name without the extension}
  625.             Cur_Ext,                         {current file extension only, no name}
  626.             Search_Ext     : String[3];      {file extension only, no name}
  627.             TotalFiles     : Byte;           {counter for displayed files}
  628.             TotalBytes     : Longint;        {counter for displayed bytes}
  629.  
  630.          Begin
  631.                {check if file exists, or if a filename has been specified}
  632.                If (DataFilename = '') OR
  633.                   {(Filename = '') OR}       {not implemented yet}
  634.                   NOT FileExists(DataFilename) Then
  635.                       Begin
  636.                            Show_File := 1;
  637.                            Exit;
  638.                       End;
  639.  
  640.                {open the file}
  641.                Assign(DataFile, DataFilename);
  642.                Reset(DataFile, 1);
  643.  
  644.                {check for the header id}
  645.                BlockRead(DataFile, Header, SizeOf(Header));
  646.                If NOT (Header.Identification = Id_Check) Then
  647.                   Begin
  648.                        {if the header is not the same then it's not one of ours}
  649.                        Show_File := 2;
  650.                        Exit;
  651.                   End;
  652.  
  653.                {Go to the beginning of the first individual file header!
  654.                 This is done already by BlockRead, but just to be on the
  655.                 safe side :)}
  656.                Seek(DataFile, SizeOf(Header));
  657.  
  658.                {loop through all the entries until [filename] is found}
  659.                Writeln;
  660.                Writeln;
  661.                Write('Listing of ' + DataFilename);
  662.                GotoXY(26, WhereY);
  663.                Write(FileSize(DataFile));
  664.                Write(' (');
  665.                Write(FileSize(DataFile) DIV 1024);
  666.                Write('k)');
  667.                Writeln;
  668.                GotoXY(1, WhereY);
  669.                Write('Created On: ');
  670.                Write(Copy(Header.CreatedOn, 1, 10));
  671.                Write(' at ');
  672.                Write(Copy(Header.CreatedOn, 11, 5));
  673.                GotoXY(35, WhereY);
  674.                Write('Last updated On: ');
  675.                Write(Copy(Header.UpdatedOn, 1, 10));
  676.                Write(' at ');
  677.                Write(Copy(Header.UpdatedOn, 11, 5));
  678.                GotoXY(71, WhereY);
  679.                Write(' Files: ');
  680.                Write(Header.NumberOffiles);
  681.                Writeln;
  682.                Writeln;
  683.                Writeln('FILENAME.EXT  SIZE                ');
  684.                Writeln('------------  --------------------');
  685.  
  686.  
  687.                TotalBytes := 0;
  688.                TotalFiles := 0;
  689.                Search_File := Copy(Filename, 1, Pos('.', Filename) - 1);
  690.                Search_Ext := Copy(Filename, Pos('.', Filename) + 1, Length(Filename));
  691.  
  692.                For CurrentFile := 1 To Header.NumberOfFiles Do
  693.                    Begin
  694.                         {read the header}
  695.                         FillChar(FileHeader, SizeOf(FileHeader), #0);
  696.                         BlockRead(DataFile, FileHeader, SizeOf(FileHeader));
  697.  
  698.                         {so the user doesn't think we're lazy :)}
  699.  
  700.                         Cur_File := Copy(FileHeader.Filename, 1, Pos('.', FileHeader.Filename) - 1);
  701.                         Cur_Ext := Copy(FileHeader.Filename, Pos('.', FileHeader.Filename) + 1, Length(FileHeader.Filename));
  702.                         If Compare_Filenames(Search_File, Cur_File) Then
  703.                            If Compare_Filenames(Search_Ext, Cur_Ext) Then
  704.                               Begin
  705.                                    OldY := WhereY;
  706.                                    Write(FileHeader.Filename);
  707.                                    GotoXY(24, OldY);
  708.                                    Write(' ' :(11 - Length(ITOA(FileHeader.RealSize))));
  709.                                    Write(FileHeader.RealSize);
  710.                                    Writeln;
  711.                                    Inc(TotalBytes, FileHeader.RealSize);
  712.                                    Inc(TotalFiles);
  713.                               End;
  714.  
  715.                         {go to the next record}
  716.                         Seek(DataFile, FilePos(DataFile) + FileHeader.RealSize);
  717.                    End;
  718.  
  719.                Writeln('------------  --------------------');
  720.                OldY := WhereY;
  721.                If (TotalBytes = 0) Then
  722.                   Writeln('No files')
  723.                Else
  724.                    If (TotalFiles = 1) Then
  725.                       Write('1 file')
  726.                    Else
  727.                        Write(ITOA(TotalFiles), ' files');
  728.                GotoXY(24, OldY);
  729.                Write(' ' :(11 - Length(ITOA(TotalBytes))));
  730.                Write(TotalBytes);
  731.                Writeln;
  732.                {If we get to here, means everything's cool}
  733.                Close(DataFile);
  734.                Show_File := 0;
  735.          End;
  736. BEGIN
  737. END.
  738.  
  739. {
  740.  ****************************************************************************
  741.  **** UNIT: VARS.PAS ********************************************************
  742.  ****************************************************************************
  743. }
  744. UNIT VARS;
  745.  
  746. INTERFACE
  747.  
  748. TYPE
  749.     {You can always use these :)}
  750.     St20   = String[20];
  751.     St40   = String[40];
  752.     St60   = String[60];
  753.     St80   = String[80];
  754.  
  755.     tHeader = Record
  756.             Identification: String[20];      {The id string, See ID_Check}
  757.             {CreatedOn/UpdatedOn are like this MM-DD-YYYYHH:MM}
  758.             CreatedOn     : String[15];      {creation date, shouldn't change}
  759.             UpdatedOn     : String[15];      {last modification date}
  760.             NumberOfFiles : Byte;            {number of files in this file}
  761.     End;
  762.  
  763.     tFileHeader = Record
  764.                 Attribute : Byte;            {Attributes:  
  765.                                               0 - None
  766.                                               1 - Hidden (N/A)
  767.                                               2 - System (N/A)
  768.                                               3 - Read Only (N/A)
  769.                                               4 - Archive (N/A)
  770.                                               5 - Directory (N/A)
  771.                                               6 - Label (N/A)
  772.                                              }
  773.                 Filename  : String[12];      {Filename as: FILENAME.EXT}
  774.                 CompType  : Byte;            {compression type:
  775.                                               0 - None/Store
  776.                                               1 - LZH (N/A)
  777.                                              }
  778.                 EncrType  : Byte;            {encryption type:
  779.                                               0 - None/Store
  780.                                               1 - XOR (N/A)
  781.                                               2 - RSA (N/A)
  782.                                              }
  783.                 RealSize  : Longint;         {actual size}
  784.                 CompSize  : Longint;         {compressed size} {N/A}
  785.                 Crc       : Longint;         {Circular Redundancy Check} {N/A}
  786.     End;
  787.  
  788. VAR
  789.    Header      : tHeader;               {the MAIN header}
  790.    FileHeader  : tFileHeader;           {each file's header}
  791.  
  792. CONST
  793.      {Please modify the ID_Check to a unique value used in your programs!
  794.       I use the below one, as there's virtually no chance of anyone using the
  795.       one below.  It just makes sure that incase a .DAT file loses the ID it
  796.       can't be read!  Sometimes I lower the String[20] to String[2] and make
  797.       it 'PK', <grin>}
  798.      Id_Check          : String[20]  = #5#255'DATAIO File';  {for checking!}
  799.  
  800.  
  801. IMPLEMENTATION
  802.  
  803. BEGIN
  804. END.
  805.  
  806. {
  807.  ****************************************************************************
  808.  **** UNIT: FILEIO.PAS ******************************************************
  809.  ****************************************************************************
  810. }
  811. UNIT FILEIO;
  812.  
  813.  
  814. INTERFACE
  815.  
  816. Uses Vars,
  817.      Dos;
  818.  
  819.      {This is from the Borland Pascal's HELP files.  I'm not sure if it's
  820.      legel to post this one, but if it's not, people in SWAG, please
  821.      replace FileExists function with anyone of the ones you guys have in
  822.      FILES.SWG :)}
  823.      FUNCTION FileExists(FileName: String): Boolean;
  824.      {Author is from SWAG archives' FILES.SWG, whoever you are, let me know
  825.      and I will credit you}
  826.      FUNCTION Compare_FileNames(SearchStr,NameStr:string): boolean;
  827.      {Author is from SWAG archives' FILES.SWG, whoever you are, let me know
  828.      and I will credit you}
  829.      PROCEDURE WipeFile(fn: string);
  830.  
  831.  
  832. IMPLEMENTATION
  833.  
  834. FUNCTION FileExists(FileName: String): Boolean;
  835. {
  836.  *** Boolean function that returns True if the file exists;otherwise,
  837.      it returns False. Closes the file if it exists.
  838.  ***
  839. }
  840.          Var
  841.             F: file;
  842.          Begin
  843.               {$I-}
  844.               Assign(F, FileName);
  845.               FileMode := 0;  { Set file access to read only }
  846.               Reset(F);
  847.               Close(F);
  848.               {$I+}
  849.               FileExists := (IOResult = 0) and (FileName <> '');
  850.          End;  { FileExists }
  851.  
  852. FUNCTION Compare_FileNames(SearchStr,NameStr:string): boolean; assembler;
  853. {
  854.  Compare SearchStr with NameStr, and allow wildcards in SearchStr.
  855.  The following wildcards are allowed:
  856.  *ABC*        matches everything which contains ABC
  857.  [A-C]*       matches everything that starts with either A,B or C
  858.  [ADEF-JW-Z]  matches A,D,E,F,G,H,I,J,W,V,X,Y or Z
  859.  ABC?         matches ABC, ABC1, ABC2, ABCA, ABCB etc.
  860.  ABC[?]       matches ABC1, ABC2, ABCA, ABCB etc. (but not ABC)
  861.  ABC*         matches everything starting with ABC
  862.  (for using with DOS filenames like DOS (and 4DOS), you must split the
  863.   filename in the extention and the filename, and compare them seperately)
  864. }
  865.  
  866. var
  867.  LastW:word;
  868. asm
  869.  cld
  870.  push ds
  871.  lds si,SearchStr
  872.  les di,NameStr
  873.  xor ah,ah
  874.  lodsb
  875.  mov cx,ax
  876.  mov al,es:[di]
  877.  inc di
  878.  mov bx,ax
  879.  or cx,cx
  880.  jnz @ChkChr
  881.  or bx,bx
  882.  jz @ChrAOk
  883.  jmp @ChrNOk
  884.  xor dh,dh
  885. @ChkChr:
  886.  lodsb
  887.  cmp al,'*'
  888.  jne @ChkQues
  889.  dec cx
  890.  jz @ChrAOk
  891.  mov dh,1
  892.  mov LastW,cx
  893.  jmp @ChkChr
  894. @ChkQues:
  895.  cmp al,'?'
  896.  jnz @NormChr
  897.  inc di
  898.  or bx,bx
  899.  je @ChrOk
  900.  dec bx
  901.  jmp @ChrOk
  902. @NormChr:
  903.  or bx,bx
  904.  je @ChrNOk
  905. {From here to @No4DosChr is used for [0-9]/[?]/[!0-9] 4DOS wildcards...}
  906.  cmp al,'['
  907.  jne @No4DosChr
  908.  cmp word ptr [si],']?'
  909.  je @SkipRange
  910.  mov ah,byte ptr es:[di]
  911.  xor dl,dl
  912.  cmp byte ptr [si],'!'
  913.  jnz @ChkRange
  914.  inc si
  915.  dec cx
  916.  jz @ChrNOk
  917.  inc dx
  918. @ChkRange:
  919.  lodsb
  920.  dec cx
  921.  jz @ChrNOk
  922.  cmp al,']'
  923.  je @NChrNOk
  924.  cmp ah,al
  925.  je @NChrOk
  926.  cmp byte ptr [si],'-'
  927.  jne @ChkRange
  928.  inc si
  929.  dec cx
  930.  jz @ChrNOk
  931.  cmp ah,al
  932.  jae @ChkR2
  933.  inc si              {Throw a-Z < away}
  934.  dec cx
  935.  jz @ChrNOk
  936.  jmp @ChkRange
  937. @ChkR2:
  938.  lodsb
  939.  dec cx
  940.  jz @ChrNOk
  941.  cmp ah,al
  942.  ja @ChkRange        {= jbe @NChrOk; jmp @ChkRange}
  943. @NChrOk:
  944.  or dl,dl
  945.  jnz @ChrNOk
  946.  inc dx
  947. @NChrNOk:
  948.  or dl,dl
  949.  jz @ChrNOk
  950. @NNChrOk:
  951.  cmp al,']'
  952.  je @NNNChrOk
  953. @SkipRange:
  954.  lodsb
  955.  cmp al,']'
  956.  loopne @SkipRange
  957.  jne @ChrNOk
  958. @NNNChrOk:
  959.  dec bx
  960.  inc di
  961.  jmp @ChrOk
  962. @No4DosChr:
  963.  cmp es:[di],al
  964.  jne @ChrNOk
  965.  inc di
  966.  dec bx
  967. @ChrOk:
  968.  xor dh,dh
  969.  dec cx
  970.  jnz @ChkChr        { Can't use loop, distance >128 bytes }
  971.  or bx,bx
  972.  jnz @ChrNOk
  973. @ChrAOk:
  974.  mov al,1
  975.  jmp @EndR
  976. @ChrNOk:
  977.  or dh,dh
  978.  jz @IChrNOk
  979.  jcxz @IChrNOk
  980.  or bx,bx
  981.  jz @IChrNOk
  982.  inc di
  983.  dec bx
  984.  jz @IChrNOk
  985.  mov ax,[LastW]
  986.  sub ax,cx
  987.  add cx,ax
  988.  sub si,ax
  989.  dec si
  990.  jmp @ChkChr
  991. @IChrNOk:
  992.  mov al,0
  993. @EndR:
  994.  pop ds
  995. end;
  996.  
  997.  
  998. PROCEDURE WipeFile(fn: string);
  999.           Var
  1000.              size,
  1001.              total: longint;
  1002.              loop,
  1003.              towrite,
  1004.              numwritten: word;
  1005.              f: file;
  1006.              buffer: array[1..1024] of byte;
  1007.  
  1008.           begin
  1009.                assign(f,fn);
  1010.                filemode := 2;
  1011.                setfattr(f,0);
  1012.                if doserror = 0 then
  1013.                   begin
  1014.                        rename(f,'~~~~~~~~.~~~');
  1015.                        rename(f,'~');
  1016.                        for loop := 1 to sizeof(buffer) do
  1017.                            buffer[loop] := random(256);
  1018.  
  1019.                        reset(f,1);
  1020.                        size := filesize(f);
  1021.                        total := 0;
  1022.                        repeat
  1023.                              {Figure out how much to write }
  1024.                              towrite := sizeof(buffer);
  1025.                              if towrite+total > size then
  1026.                                 towrite := size - total;
  1027.  
  1028.                              blockwrite(f,buffer,towrite,numwritten);
  1029.                              inc(total,numwritten);
  1030.                        until (total = size);
  1031.  
  1032.                        Seek(f,0);
  1033.                        Truncate(f);
  1034.  
  1035.                        close(f);
  1036.                        erase(f);
  1037.                   end;
  1038.           end;
  1039.  
  1040.  
  1041.  
  1042. BEGIN
  1043. END.
  1044.  
  1045. {
  1046.  ****************************************************************************
  1047.  **** UNIT: STRIO.PAS *******************************************************
  1048.  ****************************************************************************
  1049. }
  1050. { *** Handles string in/output and various conversion routines
  1051.   ***
  1052. }
  1053.  
  1054. Unit StrIO;
  1055.  
  1056. INTERFACE
  1057.  
  1058. Uses Vars;
  1059.  
  1060.      {From SWAG's CRT, modified to allow for Barlength}
  1061.      FUNCTION StatusBar(total, amt, barlength: longint): St80;
  1062.      FUNCTION ITOA(i: longint): St40;
  1063.      FUNCTION ATOI(s: St40): LongInt;
  1064.      {From SWAG}
  1065.      FUNCTION UpCase(c: Char): Char;
  1066.      FUNCTION UCase(s: String): String;
  1067.      FUNCTION RepStr(Times: Byte; Which: Char): String;
  1068.      FUNCTION Strip_Path(Fullfilename: String): String;
  1069.      FUNCTION Leading_Zero(Number: String; Digits: Byte): String;
  1070.      FUNCTION Read_Str(StrLen     : Byte;
  1071.                        InputFg,
  1072.                        InputBg    : Integer;
  1073.                        Hidden,
  1074.                        Spaces     : Char;
  1075.                        SpinWanted,
  1076.                        Display,
  1077.                        Upper,
  1078.                        OnlyNumbers,
  1079.                        AutoReturn : Boolean;
  1080.                        Default    : String): String;
  1081.      PROCEDURE Flush_Keyboard_Buffer;
  1082.      FUNCTION Right_Pad(s: String; MaxLength: Word): String;
  1083.      FUNCTION Right_Strip(s: String): String;
  1084.      FUNCTION Right_Justify(s: String; sl: Byte): String;
  1085.  
  1086. IMPLEMENTATION
  1087.  
  1088. Uses Crt;
  1089.  
  1090. FUNCTION CharStr(HowMuch: Byte; WithWhatChar: Char): String;
  1091. {
  1092.  *** fills charStr with withwhatchar to the howmuch
  1093.  ***
  1094. }
  1095.          Var
  1096.             j       : Integer;
  1097.             TempStr : St80;
  1098.  
  1099.          Begin
  1100.               TempStr := '';
  1101.               For J := 1 To HowMuch Do
  1102.                   Insert(WithWhatChar, TempStr, J);
  1103.               CharStr := TempStr;
  1104.          End;
  1105.  
  1106.  
  1107.  
  1108.  
  1109. FUNCTION StatusBar(total, amt, barlength: longint): St80;
  1110. {         Const
  1111.               BarLength = 30;}
  1112.  
  1113.          Var
  1114.             a,
  1115.             b,
  1116.             c,
  1117.             d       : longint;
  1118.             sD      : String; {for conversion}
  1119.             percent : real;
  1120.             st      : string;
  1121.  
  1122.          Begin
  1123.               If (total = 0) OR (amt = 0) Then
  1124.                  Begin
  1125.                       StatusBar := '';
  1126.                       Exit;
  1127.                  End;
  1128.               If (Amt > Total) Then
  1129.                  amt := total;
  1130.               Percent := Amt / Total * (Barlength * 10);
  1131.               a := trunc(percent);
  1132.               b := a div 10;
  1133.               c := 1;
  1134.               percent := amt / total * 100;
  1135.               d := trunc(percent);
  1136.               Str(d, sD);
  1137.               st := ' (' + sD + '%)';
  1138.               StatusBar := CharStr(b * c, #219) + CharStr(Barlength - (b * c), #176) + st;
  1139.          End;
  1140.  
  1141.  
  1142.  
  1143.  
  1144. FUNCTION ITOA(i: longint): St40;
  1145. {
  1146.  *** Converts integers into alphanumericals or strings
  1147.  ***
  1148. }
  1149.          Var
  1150.             stTemp: St20;
  1151.  
  1152.          Begin
  1153.               Str(i, stTemp);
  1154.               ITOA := stTemp;
  1155.          End;
  1156.  
  1157.  
  1158. FUNCTION ATOI(s: St40): LongInt;
  1159. {
  1160.  *** Converts a string into a integer/real
  1161.  ***
  1162. }
  1163.          Var
  1164.             Code: Integer;
  1165.             lTemp: LongInt;
  1166.             rTemp: Real;
  1167.  
  1168.          Begin
  1169.               Val(s, rTemp, Code);
  1170.               If (Code <> 0) Then
  1171.                  rTemp := 0;
  1172.               lTemp := Trunc(rTemp);
  1173.               ATOI := lTemp;
  1174.          End;
  1175.  
  1176. FUNCTION UpCase(C: Char): Char; Assembler; { will replace TP's built-in upcase }
  1177.          ASM
  1178.             MOV DL, C
  1179.             MOV AX, $6520
  1180.             INT $21
  1181.             MOV AL, DL           { function result in AL                 }
  1182.          END;
  1183.  
  1184.  
  1185. FUNCTION UCase(s: String): String;
  1186. {
  1187.  *** Converts any string(s) into upper case letters
  1188.  ***
  1189. }
  1190.          Var
  1191.             J : Integer;
  1192.  
  1193.          Begin
  1194.               For J := 1 to Length(s) Do
  1195.                   s[J] := StrIo.UpCase(s[J]);
  1196.               UCase := S;
  1197.          End;
  1198.  
  1199.  
  1200. FUNCTION RepStr(Times: Byte; Which: Char): String;
  1201.          Var
  1202.             J        : Byte;
  1203.             tString  : String;
  1204.  
  1205.          Begin
  1206.               tString := '';
  1207.               For J := 1 To Times Do
  1208.                   tString := tString + Which;
  1209.               RepStr := tString;
  1210.          End;
  1211.  
  1212.  
  1213. FUNCTION Strip_Path(Fullfilename: String): String;
  1214.          Var
  1215.             tString: String;
  1216.  
  1217.          Begin
  1218.               tString := FullFilename;
  1219.               While (Pos('\', tString) <> 0) Do
  1220.                     Delete(tString, 1, Pos('\', tString));
  1221.               Strip_Path := tString;
  1222.          End;
  1223.  
  1224.  
  1225. {
  1226.  Makes sure that NUMBER is DIGITS digits.  Ie if DIGITS = 10 and NUMBER = 29
  1227.  the result is 0000000029, 10 DIGITS :) Simple hugh?
  1228. }
  1229. FUNCTION Leading_Zero(Number: String; Digits: Byte): String;
  1230.          Var
  1231.             tString   : String;             {temporary zero holding spot}
  1232.             NeedZeros : Integer;            {Number of zeros needed}
  1233.             J         : Byte;               {for the FOR-LOOP}
  1234.  
  1235.          Begin
  1236.               tString := '';
  1237.               NeedZeros := Digits - Length(Number);
  1238.               If (NeedZeros > 0) Then
  1239.                  Begin
  1240.                       for J := 1 TO NeedZeros Do
  1241.                           tString := tString + '0';
  1242.                       tString := tString + Number;
  1243.                  End
  1244.               Else
  1245.                   tString := Number;
  1246.  
  1247.               Leading_Zero := tString;
  1248.          End;
  1249.  
  1250.  
  1251. FUNCTION Read_Str(StrLen     : Byte;
  1252.                   InputFg,
  1253.                   InputBg    : Integer;
  1254.                   Hidden,
  1255.                   Spaces     : Char;
  1256.                   SpinWanted,
  1257.                   Display,
  1258.                   Upper,
  1259.                   OnlyNumbers,
  1260.                   AutoReturn : Boolean;
  1261.                   Default    : String): String;
  1262. {
  1263.  *** Gets string from local/remote
  1264.      StrLen - String length
  1265.      InputFg - Foreground for input
  1266.      InputBg - Background for input
  1267.      Hidden - character to display instead of entered characters or #0
  1268.      Spaces - Character to display where nothing is written.
  1269.      Display - Display output
  1270.      Upper - force upper case
  1271.      OnlyNumbers - Characters between 0-9 are allowed, nothing else
  1272.      AutoReturn - Wheter to hig enter automatically after STRLENth character
  1273.      SpinWanted - Wheter or not to spin a character
  1274.      Default - Text displayed as if user/modem typed it in.
  1275.  ***
  1276. }
  1277.          Var
  1278.             ChIn    : Char;         {character read in}
  1279.             StrCount: Integer;      {current location in string}
  1280.             J       : Integer;      {used in For-loop combo}
  1281.             TempStr : String;       {temporary string}
  1282.             OldX,
  1283.             OldY,
  1284.             OldFg,
  1285.             OldBg    : Word;         {save coordinates}
  1286.             SpinCount: Byte;
  1287.  
  1288.          Const
  1289.               Spin   : Array [1..4] Of Char = ('|', '/', '-', '\');
  1290.  
  1291.          Begin
  1292.               TempStr := '';
  1293.               ChIn := #0;
  1294.               StrCount := 0;
  1295.               SpinCount := 0;
  1296.  
  1297.               if Default <> #0 Then
  1298.                  Begin
  1299.                       TempStr := Default;
  1300.                       StrCount := Length(TempStr);
  1301.                  End;
  1302.  
  1303.               If Display Then
  1304.                 Begin
  1305.                      OldX := WhereX;
  1306.                      OldY := WhereY;
  1307.                      OldFg := TextAttr MOD 16;
  1308.                      OldBg := TextAttr SHR 4;
  1309.                      TextColor(InputFg);  TextBackground(InputBg);
  1310.                      if (Spaces < #32) Then
  1311.                         Spaces := #32;
  1312.                      For J := 1 to StrLen Do
  1313.                          Write(Spaces);
  1314.                      GotoXY(OldX, OldY);
  1315.                      If (Default <> #0) Then
  1316.                         Begin
  1317.                              For J := 1 to Length(Default) Do
  1318.                                  If (Hidden <> #0) Then
  1319.                                     Write(Hidden)
  1320.                                  Else
  1321.                                      Write(Default[J]);
  1322.                         End
  1323.                 End;
  1324.               Repeat
  1325.                     Repeat
  1326.                           If SpinWanted Then
  1327.                              Begin
  1328.                                   Inc(SpinCount);
  1329.                                   If (SpinCount > 4) Then
  1330.                                      SpinCount := 1;
  1331.                                   Write(Spin[SpinCount]);
  1332.                                   GotoXY(WhereX - 1, WhereY);
  1333.                                   Delay(30);
  1334.                                   Write(' ');
  1335.                                   GotoXY(WhereX - 1, WhereY);
  1336.                              End;
  1337.                     Until Keypressed;
  1338.                     ChIn := Readkey;
  1339.  
  1340.                     If (ChIn = #0) Then
  1341.                        Exit;
  1342.  
  1343.                     If Upper then
  1344.                        ChIn := Upcase(ChIn);
  1345.  
  1346.                     Case UpCase(ChIn) Of
  1347.                         #19: Begin {left arrow}
  1348.                                    If (StrCount > 1) Then
  1349.                                       Begin
  1350.                                            Dec(StrCount, 1);
  1351.                                            If Display Then
  1352.                                               GotoXY(WhereX - 1, WhereY);
  1353.                                       End;
  1354.  
  1355.                              End;
  1356.                          #4: Begin {right arrow}
  1357.                                    If (StrCount < StrLen) Then
  1358.                                       Begin
  1359.                                            Inc(StrCount, 1);
  1360.                                            Insert(#32, TempStr, StrCount);
  1361.                                            If Display Then
  1362.                                               GotoXY(WhereX + 1, WhereY);
  1363.                                       End;
  1364.                              End;
  1365.                          #8: Begin
  1366.                                   If (StrCount > 0) Then
  1367.                                      Begin
  1368.                                           Dec(StrCount, 1);
  1369.                                           If Display Then
  1370.                                             Begin
  1371.                                                  GotoXY(WhereX - 1, WhereY);
  1372.                                                  Write(Spaces);
  1373.                                                  GotoXY(WhereX - 1, WhereY);
  1374.                                             End;
  1375.                                           Delete(TempStr, Length(TempStr), 1);
  1376.                                      End;
  1377.                                   ChIn := #0;
  1378.                              End;
  1379.                          #13: Begin
  1380.                                    If Display Then
  1381.                                       GotoXY(1, WhereY + 1);
  1382.                               End;
  1383.                        #32..#255: Begin
  1384.                                        If (StrCount < StrLen) Then
  1385.                                           Begin
  1386.                                                If OnlyNumbers Then
  1387.                                                   Begin
  1388.                                                        Case ChIn Of
  1389.                                                        '0'..'9', '.': Begin
  1390.                                                                            Inc(StrCount);
  1391.                                                                            Insert(ChIn, TempStr, StrCount);
  1392.                                                                       End;
  1393.                                                        Else {anything except numbers}
  1394.                                                            ChIn := #0;
  1395.                                                        End;
  1396.                                                   End {if onlynumbers then}
  1397.                                                Else
  1398.                                                    Begin
  1399.                                                        Inc(StrCount);
  1400.                                                        Insert(ChIn, TempStr, StrCount);
  1401.                                                    End;
  1402.                                           End
  1403.                                        Else
  1404.                                            ChIn := #0;
  1405.                                   End;
  1406.                         Else
  1407.                             ChIn := #0;
  1408.                          End; {case}
  1409.  
  1410.                          If (StrCount = StrLen) Then
  1411.                             Begin
  1412.                                  If AutoReturn Then
  1413.                                     Begin
  1414.                                          ChIn := #13;
  1415.                                          GotoXY(1, WhereY + 1);
  1416.                                     End;
  1417.                             End;
  1418.  
  1419.                          If Display AND (ChIn <> #0) Then
  1420.                             if (Hidden > #32) Then {space or no pw}
  1421.                                Write(Hidden)
  1422.                             Else
  1423.                                 Write(ChIn);
  1424.               Until (ChIn = #13) OR (ChIn = #27);
  1425.  
  1426.               If Display Then
  1427.                  Begin
  1428.                       TextColor(OldFg);
  1429.                       TextBackground(OldBg);
  1430.                  End;
  1431.  
  1432.               Read_Str := TempStr;
  1433.          End;
  1434.  
  1435.  
  1436.  
  1437. PROCEDURE Flush_Keyboard_Buffer;
  1438.           Var
  1439.              ChIn        : Char;        {for clearing the keyboard buffer}
  1440.  
  1441.           Begin
  1442.                While Keypressed Do
  1443.                      ChIn := ReadKey;
  1444.           End;
  1445.  
  1446.  
  1447. FUNCTION Right_Pad(s: String; MaxLength: Word): String;
  1448.          Const
  1449.               tString : String = '';
  1450.               HowMany : Byte = 0;
  1451.               J       : Byte = 0;
  1452.  
  1453.          Begin
  1454.               J := 0;
  1455.               HowMany := 0;
  1456.               tString := '';
  1457.  
  1458.               {check for greater then number strings}
  1459.               If (Length(s) > MaxLength) Then
  1460.                  Begin
  1461.                       tString := Copy(s, 1, MaxLength);
  1462.                       Exit;
  1463.                  End
  1464.               Else
  1465.                   Begin
  1466.                        HowMany := (MaxLength - Length(s));
  1467.                        Repeat
  1468.                              Inc(J);
  1469.                              tString := tString + #32;
  1470.                        Until J >= HowMany;
  1471.                        tString := s + tString;
  1472.                   End;
  1473.  
  1474.               Right_Pad := tString;
  1475.          End;
  1476.  
  1477. FUNCTION Right_Strip(s: String): String;
  1478.          Var
  1479.             StrLen,
  1480.             Count        : Byte;
  1481.  
  1482.          Begin
  1483.               StrLen := Length(s);
  1484.               Count  := StrLen + 1;
  1485.               Repeat
  1486.                     Dec(Count);
  1487.               Until (s[Count] <> #32);
  1488.               Delete(s, Count + 1, StrLen - Count);
  1489.               Right_Strip := S;
  1490.          End;
  1491.  
  1492. FUNCTION Right_Justify(s: String; sl: Byte): String;
  1493.          Var
  1494.             tString2,
  1495.             tString: String;
  1496.             Where,
  1497.             HowMuch: Byte;
  1498.  
  1499.          Begin
  1500.               tString := '';
  1501.               tString2 := '';
  1502.               tString := s;
  1503.               If Length(tString) > Sl Then
  1504.                  Begin
  1505.                       tString2 := Copy(tString, 1, Sl);
  1506.                       Right_Justify := tString2;
  1507.                       Exit;
  1508.                  End;
  1509.  
  1510.               Where := 1;
  1511.               Where := sl - Length(tString);
  1512.  
  1513.               FillChar(tString2, Where, #32);
  1514.               Insert(tString, tString2, Where);
  1515.               Delete(tString2, Where + Length(tString), Length(tString2) - (Where + Length(tString)) + 1);
  1516.               Right_Justify := tString2;
  1517.          End;
  1518.  
  1519.  
  1520.  
  1521.  
  1522. BEGIN
  1523. END.
  1524.  
  1525. {
  1526. PLEASE!  Anybody who can optimize this so it doesn't require as much
  1527. stack/heap space as it does now, I'd really appreciate it.  Also, if you
  1528. find a way to replace ANYTHING in here with ASM (or in any of the sub-units)
  1529. PLEASE MAIL ME THE MODIFICATIONS!  Mail to miki.landekic@canrem.com or leave
  1530. mail in the pascal echo you saw this in to Miki Landekic.  Thanks in advance
  1531.  
  1532. (written by Bojan Landekic)
  1533. }
  1534.  
  1535.